home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Windows 1993 Fall / TestDrive Windows 1993 Fall.iso / dbase / samples / areacode.prg < prev    next >
Encoding:
Text File  |  1993-03-09  |  6.3 KB  |  216 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: AREACODE.PRG
  3. *               AREACODE DATABASE SCREEN
  4. *               SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED: 06/20/90 08:00AM
  6. * WRITTEN BY:   Borland International Inc.
  7. ******************************************************************************
  8. *       FILES USED:
  9. *       Database     =  Codes.dbf  (Area code file)
  10. *       Index file   =  Codes.mdx
  11. *         TAG: City  =  city  <= Master
  12. *         TAG: Code  =  code
  13. *       External procedure file = Library.prg
  14. ******************************************************************************
  15. * Main procedure
  16. PROCEDURE Areacode
  17.  
  18.    * Link to external procedure file of "tool" procedures
  19.    SET PROCEDURE TO Library
  20.  
  21.    * Set up database environment
  22.    DO Set_env
  23.  
  24.    SET NEAR on
  25.    SET COLOR TO &c_standard.
  26.  
  27.    * Declare variables used:
  28.    * Database memory variables
  29.    city = SPACE(20)
  30.    code = 0
  31.    * Miscellaneous variables - used to pass parameters to Library
  32.    STORE "CODES" TO dbf
  33.    STORE "NOT AVAILABLE" TO mlist     && No mailing list available
  34.    STORE "N/A" TO cust_rpt            && No custom reports available
  35.    STORE "m->city" TO key, key1
  36.    STORE "NONE" TO key2, key3
  37.    keyname1 = "City:"
  38.    STORE "" TO keyname2, keyname3
  39.    list_flds = "CITY, CODE"
  40.    mcode     = 0
  41.    lookup_ok = .F.                    && lookup not applicable
  42.  
  43.    DO AreaCodeM
  44.  
  45.    RELEASE gl_MainMenu                  && Allow Rest_env to reset the
  46.    DO Rest_env                          && environment back.
  47.    ON ERROR
  48.    ON KEY LABEL F1
  49.    CLEAR ALL
  50.    CLOSE ALL
  51.    CLEAR
  52.  
  53. RETURN
  54.  
  55. PROCEDURE AreaCodeM
  56.  
  57.    * Open database file and choose active index
  58.    SELECT 1
  59.    USE Codes ORDER City
  60.    GO TOP
  61.  
  62.    record_num = RECNO()
  63.    DO Load_fld    && Load initial record from database into memory variables
  64.  
  65.    * Show data screen
  66.    CLEAR
  67.    DO Dstatus
  68.    DO Backgrnd
  69.    DO Show_data
  70.  
  71.    * Define popup menus
  72.    DO Bar_def
  73.  
  74.    * Activate main popup menu - execute user choices
  75.    SET COLOR TO &c_popup.
  76.    ACTIVATE POPUP main_mnu
  77.    DO Sub_ret
  78.  
  79. RETURN
  80. *** END MAIN PROCEDURE *******************************************************
  81.  
  82. *** UTILITY PROCEDURES (Proprietary to Areacode.prg) *************************
  83. PROCEDURE Filter
  84.    * Filter (group) data into subset
  85.    * Select subset to set up filter condition (Y=turn on, N=abort selection,
  86.    * T=turn off). If filter is already on, set default choice to T, show
  87.    * window. If filter is not on, set default choice to Y, show window.
  88.    choice = IIF(filters_on,"T","Y")
  89.    DO Filt_ans
  90.    IF choice = "Y"              && Start process of choosing filter condition
  91.       mcode  = 0
  92.       ACTIVATE WINDOW alert
  93.          * Get user's filter condition selection
  94.          @  0, 0 SAY "------- ENTER FILTER CONDITION -----"
  95.          @  2, 0 SAY "Area code:" GET mcode PICTURE "999"
  96.          READ
  97.       DEACTIVATE WINDOW alert
  98.       IF 0 <> mcode             && Check whether user entered data
  99.          SET FILTER TO code = mcode
  100.       ELSE                      && User entered no data, so exit
  101.          ?? CHR(7)
  102.          filters_on = .F.
  103.          RETURN
  104.       ENDIF
  105.       GO TOP                    && Activate filter by moving record pointer
  106.       * Check whether filter condition matches any records (none matching=EOF)
  107.       filters_on = .NOT. EOF()
  108.       IF .NOT. filters_on       && Turn off filter if no matches found
  109.          ?? CHR(7)
  110.          DO Show_msg WITH "No Areacode records match the filter condition"
  111.          SET FILTER TO
  112.          GO record_num
  113.       ENDIF
  114.    ELSE
  115.       * If user selects "T", turn off filter
  116.       SET FILTER TO
  117.       filters_on = .F.
  118.    ENDIF
  119. RETURN
  120.  
  121. PROCEDURE Indexer
  122.    * Create/rebuild index
  123.    INDEX ON code TAG Code
  124.    INDEX ON city TAG City
  125.    SET ORDER TO TAG City
  126.    GO TOP
  127. RETURN
  128.  
  129. PROCEDURE Init_fld
  130.    * Initialize memory variables for data entry
  131.    city = SPACE(20)
  132.    code = 0
  133. RETURN
  134.  
  135. PROCEDURE Load_fld
  136.    * Load field values from Codes database record into memory variables
  137.    city  = city
  138.    code  = code
  139. RETURN
  140.  
  141. PROCEDURE Repl_fld
  142.    * Replace database fields with values of current memory variables
  143.    REPLACE city WITH m->city, code WITH m->code
  144. RETURN
  145.  
  146. PROCEDURE Backgrnd
  147.    * Show background screen
  148.    * Draw lines and boxes
  149.    @  1,25 TO  3,53  DOUBLE COLOR &c_blue.
  150.    @  6,7  TO  8,38  DOUBLE COLOR &c_red.
  151.    @  9,7  TO 11,38         COLOR &c_red.
  152.    @  2,26 FILL TO  2,52    COLOR &c_blue.
  153.    @  6,7  FILL TO 11,38    COLOR &c_red.
  154.    SET COLOR TO &c_data.
  155.    @  2,27 SAY "PERSONAL AREACODE SYSTEM"
  156.    @  7,10 SAY "CITY:"
  157.    @ 10,10 SAY "CODE:"
  158.    SET COLOR TO &c_standard.
  159. RETURN
  160.  
  161. PROCEDURE Show_data
  162.    * Show data
  163.    SET COLOR TO &c_fields.
  164.    @  7,17 SAY city
  165.    @ 10,17 SAY code PICTURE "999"
  166.    SET COLOR TO &c_standard.
  167. RETURN
  168.  
  169. PROCEDURE Get_data
  170.    * Show data for data entry
  171.    SET COLOR TO &c_data.
  172.    @  7,17 GET m->city PICTURE "!XXXXXXXXXXXXXXXXXXX"
  173.    @ 10,17 GET m->code PICTURE "999"
  174.    SET COLOR TO &c_standard.
  175. RETURN
  176.  
  177. PROCEDURE Colo_rese
  178. PRIVATE old_color, c_messages, c_titles, c_box, c_info, c_fields
  179.  
  180. old_color = c_save
  181.  
  182. * Set the Primary colors
  183. SET COLOR TO &old_color.
  184.  
  185. * Remove primary colors and start at the secondary colors
  186. old_color = STUFF(old_color, 1, AT("&",old_color)+2, "")
  187.  
  188. comma = AT(",",old_color)
  189. c_messages = LEFT(old_color, comma-1)        && Get MESSAGES color
  190. old_color = STUFF(old_color, 1, comma, "")    && Remove MESSAGES color
  191.  
  192. comma = AT(",",old_color)
  193. c_titles = LEFT(old_color, comma-1)        && Get TITLES color
  194. old_color = STUFF(old_color, 1, comma, "")    && Remove TITLES color
  195.  
  196. comma = AT(",",old_color)
  197. c_box = LEFT(old_color, comma-1)        && Get BOX color
  198. old_color = STUFF(old_color, 1, comma, "")    && Remove BOX color
  199.  
  200. comma = AT(",",old_color)
  201. c_info = LEFT(old_color, comma-1)        && Get INFORMATION color
  202. old_color = STUFF(old_color, 1, comma, "")    && Remove INFORMATION color
  203.  
  204. comma = AT(",",old_color)
  205. c_fields = old_color                                    && Get FIELDS color
  206.  
  207. SET COLOR OF MESSAGES    TO &c_messages.
  208. SET COLOR OF TITLES      TO &c_titles.
  209. SET COLOR OF BOX         TO &c_box.
  210. SET COLOR OF INFORMATION TO &c_info.
  211. SET COLOR OF FIELDS      TO &c_fields.
  212. RETURN
  213.  
  214. *** END AREACODE.PRG *********************************************************
  215.  
  216.